home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Visual Basic new SourceCode and Projects / DirectXMidiPlayer / frmMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-05-30  |  6.7 KB  |  229 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "DirectMusic"
  5.    ClientHeight    =   2955
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   4680
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    ScaleHeight     =   2955
  12.    ScaleWidth      =   4680
  13.    StartUpPosition =   2  'CenterScreen
  14.    Begin VB.FileListBox File1 
  15.       Height          =   1650
  16.       Left            =   2340
  17.       Pattern         =   "*.mid"
  18.       TabIndex        =   8
  19.       Top             =   1140
  20.       Width           =   2175
  21.    End
  22.    Begin VB.DirListBox Dir1 
  23.       Height          =   1665
  24.       Left            =   180
  25.       TabIndex        =   7
  26.       Top             =   1140
  27.       Width           =   2055
  28.    End
  29.    Begin VB.HScrollBar hsbVolume 
  30.       Height          =   180
  31.       LargeChange     =   25
  32.       Left            =   2040
  33.       Max             =   10000
  34.       Min             =   -10000
  35.       TabIndex        =   6
  36.       Top             =   540
  37.       Width           =   1035
  38.    End
  39.    Begin VB.CommandButton cmdStop 
  40.       Caption         =   "Stop"
  41.       Height          =   495
  42.       Left            =   3960
  43.       TabIndex        =   5
  44.       Top             =   60
  45.       Width           =   555
  46.    End
  47.    Begin VB.Timer Timer2 
  48.       Enabled         =   0   'False
  49.       Interval        =   1
  50.       Left            =   0
  51.       Top             =   1200
  52.    End
  53.    Begin VB.PictureBox pcbProgress 
  54.       BackColor       =   &H00FFFFFF&
  55.       Height          =   135
  56.       Left            =   240
  57.       ScaleHeight     =   5
  58.       ScaleMode       =   0  'User
  59.       ScaleWidth      =   281
  60.       TabIndex        =   4
  61.       Top             =   840
  62.       Width           =   4275
  63.    End
  64.    Begin VB.Timer Timer1 
  65.       Enabled         =   0   'False
  66.       Interval        =   1000
  67.       Left            =   420
  68.       Top             =   1200
  69.    End
  70.    Begin VB.CommandButton cmdPlay 
  71.       Caption         =   "Play"
  72.       Height          =   495
  73.       Left            =   3360
  74.       TabIndex        =   0
  75.       Top             =   60
  76.       Width           =   615
  77.    End
  78.    Begin VB.Label lbl 
  79.       AutoSize        =   -1  'True
  80.       BackStyle       =   0  'Transparent
  81.       Caption         =   "Volume : 0"
  82.       Height          =   195
  83.       Index           =   2
  84.       Left            =   300
  85.       TabIndex        =   3
  86.       Top             =   540
  87.       Width           =   750
  88.    End
  89.    Begin VB.Label lbl 
  90.       AutoSize        =   -1  'True
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "0 in second : 0"
  93.       Height          =   195
  94.       Index           =   1
  95.       Left            =   300
  96.       TabIndex        =   2
  97.       Top             =   300
  98.       Width           =   1050
  99.    End
  100.    Begin VB.Label lbl 
  101.       AutoSize        =   -1  'True
  102.       BackStyle       =   0  'Transparent
  103.       Caption         =   "Time : 0"
  104.       Height          =   195
  105.       Index           =   0
  106.       Left            =   300
  107.       TabIndex        =   1
  108.       Top             =   60
  109.       Width           =   570
  110.    End
  111. Attribute VB_Name = "frmMain"
  112. Attribute VB_GlobalNameSpace = False
  113. Attribute VB_Creatable = False
  114. Attribute VB_PredeclaredId = True
  115. Attribute VB_Exposed = False
  116. Option Explicit
  117. Dim v_dx As New DirectX7
  118. Dim v_dmp As DirectMusicPerformance
  119. Dim v_dml As DirectMusicLoader
  120. Dim v_dms As DirectMusicSegment
  121. Dim v_dmss As DirectMusicSegmentState
  122. Dim vs_filename As String
  123. Dim vl_second As Long
  124. Dim vl_volume As Long
  125. Sub ErrMess(eNumber, eDesc)
  126.     Dim Msg As String
  127.     Msg = "An error has been occured."
  128.     Msg = Msg & Chr(13) & "(" & eNumber & ") - " & eDesc
  129.     MsgBox Msg, vbCritical
  130.     End
  131. End Sub
  132. Private Sub cmdPlay_Click()
  133.     On Local Error GoTo ErrSub
  134.     If vs_filename = "" Then Exit Sub
  135.     Set v_dms = v_dml.LoadSegment(vs_filename)
  136.     If StrConv(Right(vs_filename, 4), vbLowerCase) = ".mid" Then
  137.         v_dms.SetStandardMidiFile
  138.     End If
  139.     Call v_dmp.SetMasterAutoDownload(True)
  140.     Call v_dms.Download(v_dmp)
  141.     Set v_dmss = v_dmp.PlaySegment(v_dms, 0, 0)
  142.     lbl(0).Caption = "Time : " & v_dms.GetLength
  143.     pcbProgress.ScaleWidth = v_dms.GetLength
  144.     vl_second = 0
  145.     Call v_dmp.SetMasterVolume(hsbVolume.Value)
  146.     Timer1 = True
  147.     Timer2 = True
  148.     Exit Sub
  149. ErrSub:
  150.     Call ErrMess(Err.Number, Err.Description)
  151. End Sub
  152. Private Sub cmdStop_Click()
  153.     On Local Error GoTo ErrSub
  154.     If v_dms Is Nothing Then Exit Sub
  155.     Call v_dmp.Stop(v_dms, v_dmss, 0, 0)
  156.     Call v_dms.Unload(v_dmp)
  157.     vl_second = 0
  158.     pcbProgress.Cls
  159.     lbl(1).Caption = "0" & "   in second : " & vl_second
  160.     Timer1 = False
  161.     Timer2 = False
  162.     Exit Sub
  163. ErrSub:
  164.     Call ErrMess(Err.Number, Err.Description)
  165. End Sub
  166. Private Sub Dir1_Change()
  167.     On Local Error GoTo ErrSub
  168.     File1.Path = Dir1.Path
  169.     File1.Refresh
  170.     Call v_dml.SetSearchDirectory(Dir1.Path)
  171.     Exit Sub
  172. ErrSub:
  173.     Call ErrMess(Err.Number, Err.Description)
  174. End Sub
  175. Private Sub File1_Click()
  176.     vs_filename = File1.filename
  177. End Sub
  178. Private Sub Form_Load()
  179.     On Local Error GoTo ErrSub
  180.     Set v_dml = v_dx.DirectMusicLoaderCreate
  181.     Set v_dmp = v_dx.DirectMusicPerformanceCreate
  182.     Call v_dmp.Init(Nothing, hWnd)
  183.     Call v_dmp.SetPort(-1, 1)
  184.     pcbProgress.ScaleHeight = 10
  185.     Exit Sub
  186. ErrSub:
  187.     Call ErrMess(Err.Number, Err.Description)
  188. End Sub
  189. Private Sub Form_Unload(Cancel As Integer)
  190.     If v_dms Is Nothing Then GoTo OffTimers
  191.     Call v_dmp.Stop(v_dms, v_dmss, 0, 0)
  192.     Call v_dms.Unload(v_dmp)
  193. OffTimers:
  194.     Timer1 = False
  195.     Timer2 = False
  196. End Sub
  197. Private Sub hsbVolume_Change()
  198.     On Local Error GoTo ErrSub
  199.     Call v_dmp.SetMasterVolume(hsbVolume.Value)
  200.     Exit Sub
  201. ErrSub:
  202.     Call ErrMess(Err.Number, Err.Description)
  203. End Sub
  204. Private Sub hsbVolume_Scroll()
  205.     On Local Error GoTo ErrSub
  206.     Call v_dmp.SetMasterVolume(hsbVolume.Value)
  207.     Exit Sub
  208. ErrSub:
  209.     Call ErrMess(Err.Number, Err.Description)
  210. End Sub
  211. Private Sub Timer1_Timer()
  212.     On Local Error GoTo ErrSub
  213.     vl_second = vl_second + 1
  214.     lbl(1).Caption = v_dmss.GetSeek & "   in second : " & vl_second
  215.     lbl(2).Caption = "Volume : " & v_dmp.GetMasterVolume
  216.     Exit Sub
  217. ErrSub:
  218.     Call ErrMess(Err.Number, Err.Description)
  219. End Sub
  220. Private Sub Timer2_Timer()
  221.     On Local Error GoTo ErrSub
  222.     pcbProgress.Line (0, 0)-(v_dmss.GetSeek, 10), vbBlue, BF
  223.     lbl(1).Caption = v_dmss.GetSeek & "   in second : " & vl_second
  224.     lbl(2).Caption = "Volume : " & v_dmp.GetMasterVolume
  225.     Exit Sub
  226. ErrSub:
  227.     Call ErrMess(Err.Number, Err.Description)
  228. End Sub
  229.